home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / t / pragma / subs.t < prev    next >
Text File  |  1998-07-19  |  3KB  |  133 lines
  1. #!./perl 
  2.  
  3. BEGIN {
  4.     chdir 't' if -d 't';
  5.     @INC = '../lib';
  6.     $ENV{PERL5LIB} = '../lib';
  7. }
  8.  
  9. $| = 1;
  10. undef $/;
  11. my @prgs = split "\n########\n", <DATA>;
  12. print "1..", scalar @prgs, "\n";
  13.  
  14. my $Is_VMS = $^O eq 'VMS';
  15. my $Is_MSWin32 = $^O eq 'MSWin32';
  16. my $tmpfile = "tmp0000";
  17. my $i = 0 ;
  18. 1 while -f ++$tmpfile;
  19. END {  if ($tmpfile) { 1 while unlink $tmpfile} }
  20.  
  21. for (@prgs){
  22.     my $switch = "";
  23.     my @temps = () ;
  24.     if (s/^\s*-\w+//){
  25.         $switch = $&;
  26.     }
  27.     my($prog,$expected) = split(/\nEXPECT\n/, $_);
  28.     if ( $prog =~ /--FILE--/) {
  29.         my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
  30.     shift @files ;
  31.     die "Internal error test $i didn't split into pairs, got " . 
  32.         scalar(@files) . "[" . join("%%%%", @files) ."]\n"
  33.         if @files % 2 ;
  34.     while (@files > 2) {
  35.         my $filename = shift @files ;
  36.         my $code = shift @files ;
  37.             push @temps, $filename ;
  38.         open F, ">$filename" or die "Cannot open $filename: $!\n" ;
  39.         print F $code ;
  40.         close F ;
  41.     }
  42.     shift @files ;
  43.     $prog = shift @files ;
  44.     }
  45.     open TEST, ">$tmpfile";
  46.     print TEST $prog,"\n";
  47.     close TEST;
  48.     my $results = $Is_VMS ?
  49.                   `MCR $^X $switch $tmpfile` :
  50.           $Is_MSWin32 ?
  51.                   `.\\perl -I../lib $switch $tmpfile 2>&1` :
  52.                   `sh -c './perl $switch $tmpfile' 2>&1`;
  53.     my $status = $?;
  54.     $results =~ s/\n+$//;
  55.     # allow expected output to be written as if $prog is on STDIN
  56.     $results =~ s/tmp\d+/-/g;
  57.     $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
  58.     $expected =~ s/\n+$//;
  59.     my $prefix = ($results =~ s/^PREFIX\n//) ;
  60.     if ( $results =~ s/^SKIPPED\n//) {
  61.     print "$results\n" ;
  62.     }
  63.     elsif (($prefix and $results !~ /^\Q$expected/) or
  64.        (!$prefix and $results ne $expected)){
  65.         print STDERR "PROG: $switch\n$prog\n";
  66.         print STDERR "EXPECTED:\n$expected\n";
  67.         print STDERR "GOT:\n$results\n";
  68.         print "not ";
  69.     }
  70.     print "ok ", ++$i, "\n";
  71.     foreach (@temps) 
  72.     { unlink $_ if $_ } 
  73. }
  74.  
  75. __END__
  76.  
  77. # Error - not predeclaring a sub
  78. Fred 1,2 ;
  79. sub Fred {}
  80. EXPECT
  81. Number found where operator expected at - line 3, near "Fred 1"
  82.     (Do you need to predeclare Fred?)
  83. syntax error at - line 3, near "Fred 1"
  84. Execution of - aborted due to compilation errors.
  85. ########
  86.  
  87. # Error - not predeclaring a sub in time
  88. Fred 1,2 ;
  89. use subs qw( Fred ) ;
  90. sub Fred {}
  91. EXPECT
  92. Number found where operator expected at - line 3, near "Fred 1"
  93.     (Do you need to predeclare Fred?)
  94. syntax error at - line 3, near "Fred 1"
  95. BEGIN not safe after errors--compilation aborted at - line 4.
  96. ########
  97.  
  98. # AOK
  99. use subs qw( Fred) ;
  100. Fred 1,2 ;
  101. sub Fred { print $_[0] + $_[1], "\n" }
  102. EXPECT
  103. 3
  104. ########
  105.  
  106. # override a built-in function
  107. use subs qw( open ) ;
  108. open 1,2 ;
  109. sub open { print $_[0] + $_[1], "\n" }
  110. EXPECT
  111. 3
  112. ########
  113.  
  114. --FILE-- abc
  115. Fred 1,2 ;
  116. 1;
  117. --FILE--
  118. use subs qw( Fred ) ;
  119. require "./abc" ;
  120. sub Fred { print $_[0] + $_[1], "\n" }
  121. EXPECT
  122. 3
  123. ########
  124.  
  125. # check that it isn't affected by block scope
  126. {
  127.     use subs qw( Fred ) ;
  128. }
  129. Fred 1, 2;
  130. sub Fred { print $_[0] + $_[1], "\n" }
  131. EXPECT
  132. 3
  133.